COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	@* Translation to symbolic form.
C00026 ENDMK
C⊗;
@* Translation to symbolic form.
The main work of \.{DVItype} is accomplished by the |do_page| procedure,
which produces the output for an entire page, assuming that the |bop|
command for that page has already been processed. This procedure is
essentially an interpretive routine that reads and acts on the \.{DVI}
commands. 

@ The definition of \.{DVI} files refers to six registers,
$(h,v,w,x,y,z)$, which hold integer values in \.{DVI} units.  In practice,
we also need registers |hh| and |vv|, the pixel analogs of $h$ and $v$,
since it is not always true that |hh=pixel_round(h)| or
|vv=pixel_round(v)|.

The stack of $(h,v,w,x,y,z)$ values is represented by eight arrays
called |hstack|, $\ldotss$, |zstack|, |hhstack|, and |vvstack|.

@<Glob...@>=
@!h,@!v,@!w,@!x,@!y,@!z,@!hh,@!vv:integer; {current state values}
@!hstack,@!vstack,@!wstack,@!xstack,@!ystack,@!zstack:
	array [0..stack_size] of integer; {pushed down values in \.{DVI} units}
@!hhstack,@!vvstack:
	array [0..stack_size] of integer; {pushed down values in pixels}

@ Three characteristics of the pages (their |max_v|, |max_h|, and
|max_stack_depth|) are specified in the postamble, and a warning message
is printed if these limits are exceeded. Actually |max_v| is set to
the maximum height plus depth of a page, and |max_h| to the maximum width,
for purposes of page layout. Since characters can legally be set outside
of the page boundaries, it is not an error when |max_v| or |max_h| is
exceeded. But |max_stack_depth| should not be exceeded.

@<Glob...@>=
@!max_v:integer; {the value of |abs(v)| should probably not exceed this}
@!max_h:integer; {the value of |abs(h)| should probably not exceed this}
@!max_stack_depth:integer; {the stack depth should not exceed this}

@ Before we get into the details of |do_page|, it is convenient to
consider a simpler routine that computes the first parameter of each
opcode.

@d four_cases(#)==#,#+1,#+2,#+3
@d eight_cases(#)==four_cases(#),four_cases(#+4)
@d sixteen_cases(#)==eight_cases(#),eight_cases(#+8)
@d thirty_two_cases(#)==sixteen_cases(#),sixteen_cases(#+16)
@d sixty_four_cases(#)==thirty_two_cases(#),thirty_two_cases(#+32)

@p function first_par(o:eight_bits):integer;
begin case o of
sixty_four_cases(set_char_0),sixty_four_cases(set_char_0+64):
	first_par←o-set_char_0;
set1,put1,fnt1,xxx: first_par←get_byte;
set1+1,put1+1,fnt1+1: first_par←get_two_bytes;
set1+2,put1+2,fnt1+2: first_par←get_three_bytes;
right1,w1,x1,down1,y1,z1: first_par←signed_byte;
right1+1,w1+1,x1+1,down1+1,y1+1,z1+1: first_par←signed_pair;
right1+2,w1+2,x1+2,down1+2,y1+2,z1+2: first_par←signed_trio;
set1+3,set_rule,put1+3,put_rule,right1+3,w1+3,x1+3,down1+3,y1+3,z1+3,
	fnt1+3: first_par←signed_quad;
nop,bop,eop,push,pop,pst,undefined_commands: first_par←0;
w0: first_par←w;
x0: first_par←x;
y0: first_par←y;
z0: first_par←z;
sixty_four_cases(fnt_num_0): first_par←o-fnt_num_0;
end;
end;

@ Here is another subroutine that we need: It computes the number of
pixels in the height or width of a rule. Characters and rules will line up
properly if the sizes are computed precisely as specified here.  (Since
|conv| is computed with some floating-point roundoff error, in a
machine-dependent way, format designers who are tailoring something for a
particular resolution should not plan their measurements to come out to an
exact integer number of pixels; they should compute things so that the
rule dimensions are a little less than an integer number of pixels, e.g.,
4.99 instead of 5.00.)

@p function rule_pixels(x:integer):integer;
	{computes $\lceil|conv|\cdot x\rceil$}
var n:integer;
begin n←trunc(conv*x);
if n<conv*x then rule_pixels←n+1 @+ else rule_pixels←n;
end;

@ Strictly speaking, the |do_page| procedure is really a function with
side effects, not a `\&{procedure}'; it returns the value |false| if
\.{DVItype} should be aborted because of some unusual happening. The
subroutine is organized as a typical interpreter, with a multiway branch
on the command code followed by |goto| statements leading to routines that
finish up the activities common to different commands.

But first we will need to split off a part of |do_page| to reduce its
size.  We will call this portion |function do_others| and we will make a
reasonable attempt to place the less used commands in it although we will
not try to separate w0 from w1, w2, w3, and w4, nor y0 from y1, etc..

We will also find it convenient to define as global certain variables
that are used in both |do_page| and |do_others|.

@<Glob...@>=
@!cur_font:integer; {current internal font number}
@!showing:boolean; {is the current command being translated in full?}

@ We wuii use the following labels.

@d fin_set=41 {label for commands that set or put a character}
@d fin_rule=42 {label for commands that set or put a rule}
@d move_right=43 {label for commands that change |h|}
@d move_down=44 {label for commands that change |v|}
@d show_state=45 {label for commands that change |s|}
@d change_font=46 {label for commands that change |cur_font|}
@d done=30 {label for the end of a command}

@ And now for |function do_others|.

@p function do_others(o:eight_bits;p:integer;a:integer):boolean;
label change_font,move_down,9998,done;
var
@!q:integer; {parameters of the current command}
@!k:integer; {loop index}
@!bad_char:boolean; {has a non-ascii character code appeared in this |xxx|?}
begin 
@<Start  the |do_others| translation and go to the appropriate label@>
move_down: @<Finish a command that sets |v←v+p|, then |goto done|@>;
change_font: @<Finish a command that changes the current font@>;
9998: do_others←false;
done: end;

@ Now we are ready to consider |do_page| itself.


@p function do_page:boolean;
label fin_set,fin_rule,move_right,show_state,
	done,9998,9999;
var o:eight_bits; {operation code of the current command}
@!p,@!q:integer; {parameters of the current command}
@!a:integer; {byte number of the current command}
@!s:integer; {current stack size}
@!ss:integer; {stack size to print}
begin cur_font←nf; {set current font undefined}
s←0; h←0; v←0; w←0; x←0; y←0; z←0; hh←0; vv←0;
	{initialize the state variables}
while true do @<Translate the next command in the \.{DVI} file; 
		|goto 9999| with |do_page=true| if it was |eop|;
		|goto 9998| if premature termination is needed@>;
9998: print_ln('!'); do_page←false;
9999: end;

@ Commands are broken down into ``major'' and ``minor'' categories:
A major command is always shown in full, while a minor one is
put into the buffer in abbreviated form. Minor commands, which
account for the bulk of most \.{DVI} files, involve horizontal spacing
and the typesetting of characters in a line; these are shown in full
only if |out_mode=verbose|.

@d show(#)==begin flush_text; showing←true; print(a:0,': ',#);
	end
@d major(#)==if out_mode>errors_only then show(#)
@d minor(#)==if out_mode=verbose then
	begin showing←true; print(a:0,': ',#);
	end
@d error(#)==if not showing then show(#) else print(' ',#)

@<Translate the next command...@>=
begin a←cur_loc; showing←false;
o←get_byte; p←first_par(o);
@<Start translation of command |o| and |goto| the appropriate label to
	finish the job@>;
fin_set: @<Finish a command that either sets or puts a character, then
		|goto move_right| or |done|@>;
fin_rule: @<Finish a command that either sets or puts a rule, then
		|goto move_right| or |done|@>;
move_right: @<Finish a command that sets |h←h+q|, then |goto done|@>;
show_state: @<Show the values of |ss|, |h|, |v|, |w|, |x|, |y|, |z|,
	|hh|, and |vv|; then |goto done|@>;
done: if showing then print_ln(' ');
end

@ The multiway switch in |first_par|, above, was organized by the length
of each command; the one in |do_page| is organized by the semantics.

@<Start translation...@>=
if o<set_char_0+128 then @<Translate a |set_char| command@>
else case o of
	four_cases(set1): begin major('set',o-set1+1:0,' ',p:0); goto fin_set;
		end;
	set_rule: begin major('setrule'); goto fin_rule;
		end;
	put_rule: begin major('putrule'); goto fin_rule;
		end;
	@t\4@>@<Cases for |nop|, |bop|, $\ldotss$, |pop|@>@;
	@t\4@>@<Cases for horizontal motion@>@;
	othercases if do_others(o,p,a)  then goto done else goto 9998;
	end

@ @<Start  the |do_others| translation...@>=
case o of
	four_cases(put1): begin major('put',o-put1+1:0,' ',p:0); goto done;
		end;
	@t\4@>@<Cases for vertical motion@>@;
	sixty_four_cases(fnt_num_0): begin major('fntnum',p:0);
		goto change_font;
		end;
	four_cases(fnt1): begin major('fnt',o-fnt1+1:0,' ',p:0);
		goto change_font;
		end;
	xxx: @<Translate an |xxx| command and |goto done|@>;
	pst: begin error('pst occurred before eop'); goto 9998;
@.pst occurred before eop@>
		end;
	undefined_commands: begin error('undefined command ',o:0,'!');
		goto done;
@.undefined command@>
		end;
	end;

@ @<Cases for |nop|, |bop|, $\ldotss$, |pop|@>=
nop: begin minor('nop'); goto done;
	end;
bop: begin error('bop occurred before eop'); goto 9998;
@.bop occurred before eop@>
	end;
eop: begin major('eop');
	if s≠0 then error('stack not empty at end of page (level ',
		s:0,')!');
@.stack not empty...@>
	do_page←true; goto 9999;
	end;
push: begin major('push');
	if s=max_stack_depth then error('deeper than claimed in postamble!');
@.deeper than claimed...@>
@.push deeper than claimed...@>
	if s=stack_size then
		begin error('DVItype capacity exceeded (stack size=',
			stack_size:0,')'); goto 9998;
		end;
	hstack[s]←h; vstack[s]←v; wstack[s]←w;
	xstack[s]←x; ystack[s]←y; zstack[s]←z;
	hhstack[s]←hh; vvstack[s]←vv; incr(s); ss←s-1; goto show_state;
	end;
pop: begin major('pop');
	if s=0 then error('(illegal at level zero)!')
	else	begin decr(s); hh←hhstack[s]; vv←vvstack[s];
		h←hstack[s]; v←vstack[s]; w←wstack[s];
		x←xstack[s]; y←ystack[s]; z←zstack[s];
		end;
	ss←s; goto show_state;
	end;


@ Rounding to the nearest pixel is best done in the manner shown here, so as
to be inoffensive to the eye: When the horizontal motion is small, like a
kern, |hh| changes by rounding the kern; but when the motion is large, |hh|
changes by rounding the true position |h| so that accumulated rounding errors
disappear.

@d out_space(#)==if abs(p)≥font_space[cur_font] then
		begin out_text(" "); hh←pixel_round(h+p);
		end
	else hh←hh+pixel_round(p);
	minor(#,' ',p:0); q←p; goto move_right

@<Cases for horizontal motion@>=
four_cases(right1):begin out_space('right',o-right1+1:0);
	end;
w0,four_cases(w1):begin w←p; out_space('w',o-w0:0);
	end;
x0,four_cases(x1):begin x←p; out_space('x',o-x0:0);
	end;

@ Vertical motion is done similarly, but with the threshold between
``small'' and ``large'' increased by a factor of five. The idea is to make
fractions like ``$1\over2$'' round consistently, but to absorb accumulated
rounding errors in the baseline-skip moves.

@d out_vmove(#)==if abs(p)≥5*font_space[cur_font] then vv←pixel_round(v+p)
	else vv←vv+pixel_round(p);
	major(#,' ',p:0); goto move_down

@<Cases for vertical motion@>=
four_cases(down1):begin out_vmove('down',o-down1+1:0);
	end;
y0,four_cases(y1):begin y←p; out_vmove('y',o-y0:0);
	end;
z0,four_cases(z1):begin z←p; out_vmove('z',o-z0:0);
	end;

@ @<Translate an |xxx| command and |goto done|@>=
begin major('xxx'''); bad_char←false;
for k←1 to p do
	begin q←get_byte;
	if (q≥"!")∧(q≤"~") then
		begin if showing then print(xchr[q]);
		end
	else bad_char←true;
	goto done;
	end;
if showing then print('''');
if bad_char then error('non-ascii character in xxx command!');
@.non-ascii character...@>
end

@ @<Translate a |set_char|...@>=
begin if (o>" ")∧(o≤"~") then
	begin out_text(p); minor('setchar',p:0);
	end
else major('setchar',p:0);
goto fin_set;
end

@ @<Finish a command that either sets or puts a character...@>=
if font_ec[cur_font]=256 then p←256; {width computation for oriental fonts}
if (p<font_bc[cur_font])∨(p>font_ec[cur_font]) then q←invalid_width
else q←char_width(cur_font)(p);
if q=invalid_width then
	begin error('character ',p:0,' invalid in font ');
@.character $c$ invalid...@>
	print_font(cur_font);
	if cur_font≠nf then print('!');
	end;
if o≥put1 then goto done;
if q=invalid_width then q←0
else hh←hh+char_pixel_width(cur_font)(p);
goto move_right

@ @<Finish a command that either sets or puts a rule...@>=
q←signed_quad;
if showing then
	begin print(' height ',p:0,', width ',q:0);
	if (p≤0)∨(q≤0) then print(' (invisible)')
	else print(' (',rule_pixels(p):0,'x',rule_pixels(q):0,' pixels)');
	end;
if o=put_rule then goto done;
hh←hh+rule_pixels(q); goto move_right

@ Since \.{DVItype} is intended to diagnose strange errors, it checks
carefully to make sure that |h| and |v| do not get out of range.
Normal \.{DVI}-reading programs need not do this.

@d infinity==@'17777777777 {$\infty$ (approximately)}

@<Finish a command that sets |h←h+q|, then |goto done|@>=
if (h>0)∧(q>0) then if h>infinity-q then
	begin error('arithmetic overflow! parameter changed from ',
@.arithmetic overflow...@>
		q:0,' to ',infinity-h:0);
	q←infinity-h;
	end;
if (h<0)∧(q<0) then if -h>q+infinity then
	begin error('arithmetic overflow! parameter changed from ',
		q:0, ' to ',(-h)-infinity:0);
	q←(-h)-infinity;
	end;
if showing then
	begin print(' h:=',h:0);
	if q≥0 then print('+');
	print(q:0,'=',h+q:0,', hh:=',hh:0);
	end;
h←h+q;
if abs(h)>max_h then
	begin error('warning: |h|>',max_h:0,'!');
@.warning:...@>
	max_h←abs(h);
	end;
goto done

@ @<Finish a command that sets |v←v+p|, then |goto done|@>=
if (v>0)∧(p>0) then if v>infinity-p then
	begin error('arithmetic overflow! parameter changed from ',
@.arithmetic overflow...@>
		p:0,' to ',infinity-v:0);
	p←infinity-v;
	end;
if (v<0)∧(p<0) then if -v>p+infinity then
	begin error('arithmetic overflow! parameter changed from ',
		p:0, ' to ',(-v)-infinity:0);
	p←(-v)-infinity;
	end;
if showing then
	begin print(' v:=',v:0);
	if p≥0 then print('+');
	print(p:0,'=',v+p:0,', vv:=',vv:0);
	end;
v←v+p;
if abs(v)>max_v then
	begin error('warning: |v|>',max_v:0,'!');
@.warning:...@>
	max_v←abs(v);
	end;
goto done

@ @<Show the values of |ss|, |h|, |v|, |w|, |x|, |y|, |z|...@>=
if showing then
	begin print_ln(' ');
	print('level ',ss:0,':(h=',h:0,',v=',v:0,
		',w=',w:0,',x=',x:0,',y=',y:0,',z=',z:0,
		',hh=',hh:0,',vv=',vv:0,')');
	end

@ @<Finish a command that changes the current font@>=
font_num[nf]←p; cur_font←0;
while font_num[cur_font]≠p do incr(cur_font);
if showing then
	begin print(' current font is '); print_font(cur_font);
	end;
goto done